home *** CD-ROM | disk | FTP | other *** search
/ Aminet 37 / Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso / Aminet / util / rexx / FWCalendar.lha / FWCalendar / FWCAddEvent.rexx < prev    next >
OS/2 REXX Batch file  |  2000-03-04  |  63KB  |  1,849 lines
  1. /*
  2.     AddEvent.rexx Macro
  3.     Adds events to calendars created by FWCalendar.rexx
  4.     $VER: FWCAddEvent.rexx v3.76 (4 Mar 2000)
  5.     ©Ron Goertz (goertz@earthlink.net)
  6. */
  7.  
  8. OPTIONS RESULTS
  9. signal on syntax
  10.  
  11. call AddLibraries
  12. bguiopen = bguiopen()
  13. if ErrorCount > 0 then call Cleanup
  14.  
  15. parse source . . . FullCallPath . CallHost
  16. CallHost = strip(CallHost)
  17. ScriptDir = PathPart(FullCallPath)
  18.  
  19. CurrentDir = upper(Pragma('D'))
  20. if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'
  21.  
  22. if (pos('FINALWRITER', CurrentDir) > 0) | (left(CallHost, 6) == 'FINALW') then do
  23.   App     = 'FW'
  24.   AppName = 'FINALWRITER'
  25.   if CallHost == 'REXX' then address value substr(PortList, pos('FINALW.', PortList), 8)
  26.   GETDOCITEMPREFS Decimal; DecimalFormat = result
  27.   DOCITEMPREFS Decimal Period
  28. end
  29. else if (pos('PAGESTREAM', CurrentDir) > 0) | (CallHost == 'PAGESTREAM') then do
  30.   App     = 'PGS'
  31.   AppName = 'PAGESTREAM'
  32.   address 'PAGESTREAM'
  33. end
  34.  
  35. call SetVariables
  36.  
  37. Month = substr(TempDate,5,2)
  38. if left(Month,1) == "0" then Month = right(Month,1)
  39. PrevMonth = Month - 1
  40. if PrevMonth = 0 then PrevMonth = 12
  41. NextMonth = Month + 1
  42. if NextMonth = 13 then NextMonth = 1
  43.  
  44. Year = left(TempDate,4)
  45. if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2  = 29
  46.  
  47. interpret "StartDate = Day."Date('W', TempDate, 'S')
  48. if (DoExtended == 0) | (StartDate + MonthLength.Month > 35) then MaxDate = MonthLength.Month
  49. else MaxDate = 35 - StartDate
  50.  
  51. FontName = Font.Highlight
  52. FontSize = FSize.Highlight
  53. call GetEvent
  54. exit
  55.  
  56. /*********************************************/
  57. /*              Subroutines                  */
  58. /*********************************************/
  59. /***//*******  AddLibraries (AL) Subroutine  ***********/
  60. AddLibraries:
  61.   PortList     = show('P')
  62.   ErrorCount   = 0
  63.   WarningCount = 0
  64.   Req          = 0
  65.   bguiopen     = 0
  66.   EventFile    = ''
  67.   DefScreen    = ''
  68.  
  69.   Storage         = 'RAM:FWC/'
  70.   Notice$         = 'notice'
  71.   Critical$       = 'Critical error'
  72.   See$            = 'see'
  73.   SeeOutput$      = 'see the output above for details'
  74.   ForDetails$     = 'for details'
  75.   ForwardLog$     = 'Forward log file to'
  76.   Unable$         = 'if you are unable to resolve the problem.'
  77.   ForwardContent$ = 'Forward contents of output to'
  78.   SeeShell$       = 'see the shell output for details'
  79.   OK$             = '_OK'
  80.  
  81.   AL_Libs        = 'rexxsupport.library rexxbgui.library bgui.library'
  82.   AL_MinVersions = ' 34.9                4.0             41.10       '
  83.   AL_Offsets     = '-30                -30              -30          '
  84.   do AL_i = 1 to words(AL_Libs)
  85.     AL_Lib        = word(AL_Libs, AL_i)
  86.     AL_MinVersion = word(AL_MinVersions, AL_i)
  87.     AL_Offset     = word(AL_Offsets, AL_i)
  88.     if exists('LIBS:'AL_Lib) then do
  89.       AL_InstalledVersion = libver(AL_Lib)
  90.       if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == 'unknown') then do
  91.         call AddMsg('E', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
  92.       end
  93.       else if pos('rexx', AL_Lib) > 0 then call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
  94.     end
  95.     else call AddMsg('E', AL_lib' is required but could not be found.')
  96.   end
  97.  
  98.   AL_Libs        = 'rexxtricks.library'
  99.   AL_MinVersions = '  0               '
  100.   AL_Offsets     = '-30               '
  101.   AL_Variables   = 'RexxTricks        '
  102.   do AL_i = 1 to words(AL_Libs)
  103.     AL_Lib        = word(AL_Libs, AL_i)
  104.     AL_MinVersion = word(AL_MinVersions, AL_i)
  105.     AL_Offset     = word(AL_Offsets, AL_i)
  106.     AL_Variable   = word(AL_Variables, AL_i)
  107.     if exists('LIBS:'AL_lib) then do
  108.       AL_InstalledVersion = libver(AL_lib)
  109.       if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == 'unknown') then do
  110.         call AddMsg('W', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
  111.         interpret Al_Variable' = 0'
  112.       end
  113.       else do
  114.         call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
  115.         interpret Al_Variable' = 1'
  116.       end
  117.     end
  118.     else interpret Al_Variable' = 0'
  119.   end
  120.  
  121.   if ErrorCount > 0 then call Cleanup
  122.   return
  123. /**/
  124.  
  125. /***//*******  AddMsg (AM) Subroutine  ***********/
  126. AddMsg:
  127.   parse arg AM_MsgType, AM_Msg
  128.  
  129.   if AM_MsgType == 'E' then do
  130.     ErrorCount = ErrorCount + 1
  131.     Error.ErrorCount = AM_Msg
  132.   end
  133.   else do
  134.     WarningCount = WarningCount + 1
  135.     Warning.WarningCount = AM_Msg
  136.   end
  137.  
  138.   return
  139. /**/
  140.  
  141. /***//*******  Cleanup () Subroutine  ***********/
  142. Cleanup:
  143.   signal off syntax
  144.  
  145.   if VariablesSet == 1 then do
  146.     interpret UserPrefs
  147.     if Req ~= 0 then call bguiwinclose(Req)
  148.     if App == 'FW' then do
  149.       SELECTOBJECT
  150.       REDRAW
  151.       if upper(DecimalFormat) == 'COMMA' then DocItemPrefs Decimal Comma
  152.     end
  153.     else if App == 'PGS' then do
  154.       SELECTOBJECT None WINDOW winName
  155.       if WindowRefreshed ~= 1 then do
  156.         REFRESH ON
  157.         REFRESHWINDOW WINDOW winName
  158.       end
  159.     end
  160.   end
  161.  
  162.   LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  163.   if LogOpen == 1 then OutType = 'File'
  164.   if (ErrorCount > 0) & (LogOpen == 0) then do
  165.     LogOpen = 1
  166.     call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
  167.     OutType = 'CON'
  168.   end
  169.  
  170.   if LogOpen == 1 then do
  171.     call writeln('FWCLog', '      Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
  172.     call writeln('FWCLog', 'Application: 'PgmVersion)
  173.     call writeln('FWCLog', 'Current Dir: 'CurrentDir)
  174.     call writeln('FWCLog', ' Script Dir: 'ScriptDir)
  175.     call writeln('FWCLog', '       Host: 'CallHost)
  176.     call writeln('FWCLog', '   Calendar: 'Month.Month' 'Year||'0a'x)
  177.   end
  178.  
  179.   if (ErrorCount > 0) | (WarningCount > 0) then do
  180.     do i = 1 to ErrorCount
  181.       call writeln('FWCLog', Error.i)
  182.     end
  183.  
  184.     do i = 1 to WarningCount
  185.       call writeln('FWCLog', Warning.i)
  186.     end
  187.  
  188.     if exists(PrefsFile) then do
  189.       call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
  190.       call open('DataFile', PrefsFile)
  191.         do until eof('DataFile')
  192.           Ln = ReadLn('DataFile')
  193.           if pos('End Pass One', Ln) > 0 then leave
  194.           call writeln('FWCLog', Ln)
  195.         end
  196.       call close('DataFile')
  197.     end
  198.  
  199.     if EventFile ~= '' then do
  200.       call writeln('FWCLog', '0a'x||' -- 'EventFile' -- ')
  201.       call open('DataFile', EventFile)
  202.         do until eof('DataFile')
  203.           call writeln('FWCLog', ReadLn('DataFile'))
  204.         end
  205.       call close('DataFile')
  206.     end
  207.  
  208.     if ErrorCount > 0 then ErrorType = Critical$
  209.     else ErrorType = Noncritical$
  210.     FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  211.     Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  212.     ConCon  = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  213.     if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
  214.     if (OutType == 'File') & (bguiopen == 0) then do
  215.       call open('CON', 'CON:10/10/500/300/FWCAddEvent notice/WAIT/CLOSE')
  216.         call writeln('CON', FileMsg)
  217.       call close('CON')
  218.     end
  219.     if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
  220.     if (OutType == 'CON') & (bguiopen == 0) then call Writeln('FWCLog', '0a'x||ConCon)
  221.   end
  222.   else do
  223.     address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
  224.     if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
  225.   end
  226.  
  227.   address command 'delete >NIL: 'Storage'FWCTemp quiet'
  228.   call close('FWCLog')
  229.   if bguiopen = 1 then call bguiclose()
  230.   if DefScreen ~= '' then call setdefaultpubscreen(DefScreen)
  231.   exit
  232. /**/
  233.  
  234. /***//*******  ConvertDay (CD) Subroutine ***********/
  235. ConvertDay:
  236.   parse arg CD_Day
  237.   If upper(left(CD_Day,1)) == "P" then CD_Day = substr(CD_Day,2) - MonthLength.PrevMonth
  238.   If upper(left(CD_Day,1)) == "N" then CD_Day = substr(CD_Day,2) + MonthLength.Month
  239.   return CD_Day
  240. /**/
  241.  
  242. /***//*******  DrawBox (DB) Subroutine  ***********/
  243. DrawBox:
  244.   parse arg DB_x1, DB_y1, DB_Width, DB_Height, DB_Weight, DB_Color, DB_FillBool, DB_FillColor, DB_Tint
  245.  
  246.   if DB_FillColor == '<'Clear$'>' then DB_FillBool = 0
  247.  
  248.   if App == 'FW' then do
  249.     if DB_Weight == 'HL' then DB_Weight = 'Hairline'
  250.     else if DB_Weight == 0 then do
  251.       DB_Weight = 'None'
  252.       if DB_FillColor ~= '<'Clear$'>' then DB_Color = DB_FillColor
  253.     end
  254.  
  255.     if DB_FillBool == 1 then DB_FillBool = 'Solid'
  256.     else do
  257.       DB_FillBool = 'Transparent'
  258.       DB_FillColor = DB_Color
  259.     end
  260.  
  261.     BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_Color'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
  262.     DRAWBOX 1 DB_x1 DB_y1 DB_Width DB_Height; DB_id = result
  263.   end
  264.   else if App == 'PGS' then do
  265.     if DB_Weight == 'HL' then DB_Weight = 0.3pt
  266.     else DB_Weight = DB_Weight'pt'
  267.  
  268.     if DB_FillBool == 1 then DB_FillBool = 'ON'
  269.     else DB_FillBool = 'OFF'
  270.  
  271.     If DB_Weight == 0 then DB_LineBool = 'OFF'
  272.     else DB_LineBool = 'ON'
  273.  
  274.     DRAWBOX DB_x1 DB_y1 DB_x1 + DB_Width DB_y1 + DB_Height WINDOW winName; DB_id = result
  275.     STROKED DB_LineBool OBJECTID DB_id WINDOW winName
  276.     SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECTID DB_id WINDOW winName
  277.     SETCOLORSTYLE '"'DB_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECTID DB_id WINDOW winName
  278.     FILLED DB_FillBool OBJECTID DB_id WINDOW winName
  279.     SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECTID DB_id WINDOW winName
  280.     SETCOLORTINT DB_Tint FILL OBJECTID DB_id WINDOW winName
  281.   end
  282.   return DB_id
  283. /**/
  284.  
  285. /***//*******  GetEvent (GE) Subroutine  ***********/
  286. GetEvent:
  287.   do GE_i = 0 to 15
  288.     linelist_.GE_i = GE_i
  289.   end
  290.   linelist_.COUNT = min(RowsThatFit, 16)
  291.  
  292.   call bguilist("eventlist_",Event$,File$)
  293.   call bguilist("FrequencyList", Once$, Weekly$, Biweekly$)
  294.  
  295.   GE_StartOrEnd   = 1
  296.   GE_StartDate    = ""
  297.   GE_EndDate      = ""
  298.   GE_Boxed.0      = ""
  299.   GE_Boxed.128    = "B"
  300.   GE_Weekly.0     = ""
  301.   GE_Weekly.1     = "W"
  302.   GE_Weekly.2     = "2"
  303.   GadID.          = ''
  304.   GE_Arg.         = ''
  305.   GE_i            = 0
  306.   GE_Day          = 0
  307.   GE_PrevDay      = MonthLength.PrevMonth - StartDate
  308.   GE_NextDay      = 0
  309.  
  310.   Req = OpenBusy(PrepReq$'...', 45)
  311.   do while (GE_i < 6)
  312.     GE_j = 0
  313.     do while (GE_j < 7)
  314.       call UpdateBusy(Req, 1)
  315.       GE_SerialPosition = (GE_i * 7) + GE_j
  316.       GE_Button = GE_SerialPosition + 1
  317.       if (GE_SerialPosition >= StartDate) & (GE_SerialPosition < StartDate + MonthLength.Month) then Do
  318.         GE_Day = GE_Day + 1
  319.         interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_Day)"
  320.         GadID = GetID(GE_Button'_')
  321.         GE_Arg.GadID = 'C 'left(Month.Month, 3)' 'GE_Day
  322.       end
  323.       else do
  324.         if GE_SerialPosition < StartDate then Do
  325.           GE_PrevDay = GE_PrevDay + 1
  326.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_PrevDay)"
  327.           GadID = GetID(GE_Button'_')
  328.           GE_Arg.GadID = 'P 'left(Month.PrevMonth, 3)' 'GE_PrevDay
  329.         end
  330.         else do
  331.           GE_NextDay = GE_NextDay + 1
  332.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_NextDay)"
  333.           GadID = GetID(GE_Button'_')
  334.           GE_Arg.GadID = 'N 'left(Month.NextMonth, 3)' 'GE_NextDay
  335.         end
  336.       end
  337.       GE_j = GE_j + 1
  338.     end
  339.     GE_i = GE_i + 1
  340.     if GE_SerialPosition >= StartDate + MonthLength.Month - 1 then leave
  341.   end
  342.  
  343.   DateButtons = bguihgroup(GadID.1""GadID.2""GadID.3""GadID.4""GadID.5""GadID.6""GadID.7)||,
  344.                 bguihgroup(GadID.8""GadID.9""GadID.10""GadID.11""GadID.12""GadID.13""GadID.14)||,
  345.                 bguihgroup(GadID.15""GadID.16""GadID.17""GadID.18""GadID.19""GadID.20""GadID.21)||,
  346.                 bguihgroup(GadID.22""GadID.23""GadID.24""GadID.25""GadID.26""GadID.27""GadID.28)
  347.   if GE_i > 4 then DateButtons = DateButtons''bguihgroup(GadID.29""GadID.30""GadID.31""GadID.32""GadID.33""GadID.34""GadID.35)
  348.   if GE_i > 5 then DateButtons = DateButtons''bguihgroup(GadID.36""GadID.37""GadID.38""GadID.39""GadID.40""GadID.41""GadID.42)
  349.  
  350.   g=bguivgroup(,
  351.     bguihgroup(,
  352.       bguicycle("eventtype_",,"eventlist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  353.       bguistring("event_",,,256)bguilayout(LGO_FixMinHeight,1),
  354.     )||,
  355.     bguihgroup(,
  356.       bguistring('fontvalue_',Font$,FontName,256)bguilayout(LGO_Weight,50,LGO_FixMinHeight,1)||,
  357.       bguistring('fontsize_',,FontSize,8)bguilayout(LGO_Weight,10,LGO_FixMinHeight,1)||,
  358.       bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  359.       bguibutton("reset_",Reset$)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1),
  360.     )||,
  361.     bguihgroup(,
  362.       bguivgroup(,
  363.         bguiinfo('dummy_',,esc'c'Month.Month)bguilayout(LGO_FixMinHeight, 1)||,
  364.         bguihgroup(,
  365.           bguiinfo("dummy_",,esc"c"left(Day.0,1))||,
  366.           bguiinfo("dummy_",,esc"c"left(Day.1,1))||,
  367.           bguiinfo("dummy_",,esc"c"left(Day.2,1))||,
  368.           bguiinfo("dummy_",,esc"c"left(Day.3,1))||,
  369.           bguiinfo("dummy_",,esc"c"left(Day.4,1))||,
  370.           bguiinfo("dummy_",,esc"c"left(Day.5,1))||,
  371.           bguiinfo("dummy_",,esc"c"left(Day.6,1)),
  372.         )||,
  373.         DateButtons,
  374.       )||,
  375.       bguivgroup(,
  376.         bguiinfo("startchoice_",esc"r"Start$,"")bguilayout(LGO_FixMinHeight, 1)||,
  377.         bguiinfo("endchoice_",esc"r"End$,"")bguilayout(LGO_FixMinHeight, 1)||,
  378.         bguicycle('textcolor_',esc"r"TextColor$,'TextColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  379.         bguicycle("linechoice_",esc"r"Line$,"linelist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  380.         bguicheckbox("boxchoice_",esc"r"Boxed$,0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  381.         bguicycle('boxcolor_',esc"r"BoxColor$,'ColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  382.         bguicycle("weeklychoice_",esc"r"Frequency$,'FrequencyList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  383.         bguihgroup(,
  384.           bguibutton("OK_",OK$)bguilayout(LGO_FixMinHeight,1)||,
  385.           bguibutton("cancel_",Cancel$)bguilayout(LGO_FixMinHeight,1),
  386.         ),
  387.       ),
  388.     ),
  389.   ,"-1","-1")
  390.  
  391.   call UpdateBusy(Req, 1)
  392.   GE_winID=bguiwindow(EnterEventInfo$,g,5,0,,PubScreen)
  393.   call UpdateBusy(Req, 1)
  394.  
  395.   if App == 'PGS' then do
  396.     FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
  397.     call UpdateBusy(Req, 1)
  398.     FontwinID=bguiwindow(SelectFont$,FontGroup,20,50,,PubScreen)
  399.   end
  400.  
  401.   call bguiset(obj.linechoice_,GE_winID,CYC_Active,1)
  402.   call bguiset(obj.boxcolor_,GE_winID,CYC_Active,max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0)))
  403.   call bguiset(obj.textcolor_,GE_winID,CYC_Active,max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0)))
  404.   call bguiset(obj.event_,,BT_Key,EventKey)
  405.   call bguiwintabcycleorder(GE_winID,obj.event_||obj.fontsize_)
  406.  
  407.   if bguiwinopen(GE_winID)=0 then bguierror(12)
  408.  
  409.   if Req ~= 0 then call bguiwinclose(Req)
  410.   Req = 0
  411.  
  412.   id=0
  413.   do while 1
  414.     call bguiwinwaitevent(GE_winID,"ID")
  415.     select
  416.       when (id == id.cancel_) | (id == id.winclose) then call Cleanup
  417.       when id == id.winactive then nop
  418.       when id == id.wininactive then nop
  419.       when id == id.event_ then nop
  420.       when id == id.linechoice_ then nop
  421.       when id == id.boxchoice_ then nop
  422.       when id == id.textcolor_ then nop
  423.       when id == id.boxcolor_ then nop
  424.       when id == id.weeklychoice_ then nop
  425.       when id == id.reset_ then do
  426.         FontName = Font.Highlight
  427.         FontSize = FSize.Highlight
  428.         call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontName)
  429.         call bguiset(obj.fontsize_, GE_winID, STRINGA_TextVal,FontSize)
  430.       end
  431.       when id == id.fontvalue_ then do
  432.         call bguireq('1b'x||"c"MustUse$,"*"OK$,'',GE_winID)
  433.         call bguiset(obj.fontvalue_, GE_winID,STRINGA_TextVal, FontName)
  434.       end
  435.       when id == id.fontsize_ then nop
  436.       when id == id.addfont_ then do
  437.         call bguiwinbusy(GE_winID)
  438.         if App == 'FW' then do
  439.           FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$, GE_winID,,'#?')
  440.           if FontFile ~= '' then call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontFile)
  441.         end
  442.         else if App == 'PGS' then do
  443.           call bguiwinopen(FontwinID)
  444.           do while 1
  445.             call bguiwinwaitevent(FontwinID,'ID')
  446.             if id == id.winclose then leave
  447.             if id == id.fontlistview_ then do
  448.               call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
  449.               leave
  450.             end
  451.           end
  452.           call bguiwinclose(FontwinID)
  453.         end
  454.         call bguiwinready(GE_winID)
  455.         FontName = bguiget(obj.fontvalue_, STRINGA_TextVal)
  456.       end
  457.       when id == id.ok_ then do
  458.         GE_EventValue = bguiget(obj.event_, STRINGA_TextVal)
  459.         GE_BoxValue   = bguiget(obj.boxchoice_, GA_Selected)
  460.         if GE_StartDate = "" then call bguireq(EnterStartDate$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  461.         else if (GE_EventValue == "") & (GE_Boxed.GE_BoxValue == "") then call bguireq(EnterEvent$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  462.         else do
  463.           GE_WeeklyValue  = bguiget(obj.weeklychoice_, CYC_Active)
  464.           GE_EventType = bguiget(obj.eventtype_, CYC_Active)
  465.  
  466.           EventData = "   EventType = "Type.GE_EventType||'0a'x||,
  467.                       " EnteredFont = "strip(FontName)||'0a'x||,
  468.                       " EnteredSize = "strip(bguiget(obj.fontsize_, STRINGA_TextVal))||'0a'x||,
  469.                       " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
  470.                       " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
  471.                       " EnteredLine = "bguiget(obj.linechoice_, CYC_Active)||'0a'x||,
  472.                       "     Options = "GE_Boxed.GE_BoxValue""GE_Weekly.GE_WeeklyValue||'0a'x||,
  473.                       "   TextColor = "value('ColorList.'bguiget(obj.textcolor_, CYC_Active))||'0a'x||,
  474.                       "    BoxColor = "value('ColorList.'bguiget(obj.boxcolor_, CYC_Active))||'0a'x||,
  475.                       "EnteredEvent = "GE_EventValue
  476.  
  477.           call bguiwinclose(GE_winID)
  478.           call ProcessEvent
  479.           call bguiwinopen(GE_winID)
  480.  
  481.           GE_StartOrEnd = 1
  482.           GE_StartDate  = ""
  483.           GE_EndDate    = ""
  484.           call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,'')
  485.           call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,'')
  486.         end
  487.       end
  488.       when id == id.eventtype_ then do
  489.         GE_EventType = bguiget(obj.eventtype_, CYC_Active)
  490.         if Type.GE_EventType == Event$ then do
  491.           call bguiset(obj.event_,GE_winID,STRINGA_TextVal,"")
  492.           call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
  493.           call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
  494.           call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
  495.           call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
  496.           call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
  497.           call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
  498.           call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
  499.           call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
  500.           call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
  501.         end
  502.         else do
  503.           GE_DataFile = bguifilereq(ScriptDir''"FWCAddEvent.data", SelectFile$, GE_winID,DOPATTERNS,PatVar)
  504.           if ~exists(GE_DataFile) then do
  505.             call bguireq(GE_DataFile' 'CantFind$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  506.             GE_DataFile = ''
  507.           end
  508.           if GE_DataFile == '' then do
  509.             call bguiset(obj.eventtype_, GE_winID, CYC_Active, 0)
  510.             call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
  511.             call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
  512.             call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
  513.             call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
  514.             call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
  515.             call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
  516.             call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
  517.             call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
  518.             call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
  519.           end
  520.           else do
  521.             call bguiset(obj.event_, GE_winID, STRINGA_TextVal,GE_DataFile)
  522.             call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 1)
  523.             call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 1)
  524.             call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 1)
  525.             call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 1)
  526.             call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 1)
  527.             call bguiset(obj.reset_, GE_winID, GA_Disabled, 1)
  528.             call bguiset(obj.addfont_, GE_winID, GA_Disabled, 1)
  529.             call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 1)
  530.             call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 1)
  531.           end
  532.         end
  533.       end
  534.       otherwise do
  535.         GE_StartOrEnd = 1 - GE_StartOrEnd
  536.         GE_ReturnDate = strip(substr(GE_Arg.id, 1, 1)""right(GE_Arg.id, 2), "B", "C")
  537.         GE_Date = substr(GE_Arg.id, 3)
  538.         if GE_StartOrEnd == 0 then do
  539.           call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
  540.           GE_StartDate = GE_ReturnDate
  541.         end
  542.         else do
  543.           call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
  544.           GE_EndDate = GE_ReturnDate
  545.         end
  546.       end
  547.     end
  548.   end
  549.   exit
  550. /**/
  551.  
  552. /***//*******  GetFontWidth (GFW) Subroutine  *********/
  553. GetFontWidth:
  554.   parse arg GFW_FontType, GFW_Char
  555.  
  556.   GFW_ID = PrintText(1, 1, GFW_FontType, 'N', White$, Width.GFW_FontType, GFW_Char)
  557.   if App == 'FW' then do
  558.     REDRAW
  559.     GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
  560.     DELETEOBJECT GFW_ID
  561.   end
  562.   else if App == 'PGS' then do
  563.     GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
  564.     GFW_Width = GFW_Text.Right - GFW_Text.Left
  565.     DELETEOBJECT OBJECTID GFW_ID WINDOW winName
  566.   end
  567. return GFW_Width
  568. /**/
  569.  
  570. /***//*******  GetHeight (GH) Subroutine  ***********/
  571. GetHeight:
  572.   parse arg GH_FontType
  573.  
  574.   if App == 'FW' then do
  575.     TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
  576.     DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
  577.     GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
  578.     DELETEOBJECT GH_id
  579.   end
  580.   else if App == 'PGS' then do
  581.     DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
  582.     SELECTTEXT AT 0 0 WINDOW winName
  583.     BEGINCOMMANDCAPTURE
  584.       SETLEADING RELATIVE 100
  585.       SETTYPESIZE FSize.GH_FontType WINDOW winName
  586.       SETFONT Font.GH_FontType WINDOW winName
  587.     ENDCOMMANDCAPTURE
  588.     INSERT 'A' WINDOW winName
  589.     GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
  590.     GH_Text.Height = GH_Text.Bottom - GH_Text.Top
  591.     DELETEOBJECT OBJECTID GH_id WINDOW winName
  592.   end
  593.   return GH_Text.Height
  594. /**/
  595.  
  596. /***//*******  GetID (GI) Subroutine  ***********/
  597. GetID:
  598. parse arg GI_var
  599.  
  600. return id.GI_var
  601. /**/
  602.  
  603. /***//*******  GetLogInfo () Subroutine  ***********/
  604. GetLogInfo:
  605.   if ~exists(Storage'FWC'App'Temp.txt') then address command 'list >'Storage'FWC'App'Temp.txt 'AppName'#? lformat %N'
  606.   if open('Temp', Storage'FWC'App'Temp.txt') ~= 0 then do
  607.     do while ~eof('Temp')
  608.       PgmName = readln('Temp')
  609.       if pos('.', PgmName) == 0 then leave
  610.     end
  611.     call close('Temp')
  612.   end
  613.  
  614.   if ~exists(Storage'FWC'App'VersionInfo.txt') then address command 'version >'Storage'FWC'App'VersionInfo.txt 'PgmName
  615.  
  616.   call open('Temp', Storage'FWC'App'VersionInfo.txt')
  617.     PgmVersion = readln('Temp')
  618.   call close('Temp')
  619.  
  620.   if left(PgmVersion, 34) == 'Could not find version information' then do
  621.     if App == 'FW' then do
  622.       call open('Temp', CurrentDir''PgmName)
  623.         /* Desired string at 325365 for v 5.06 */
  624.         /* Desired string at 333771 for FW97   */
  625.         FileOffset = 325300
  626.         call seek('Temp', FileOffset, 'B')
  627.         do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  628.           PrevOffset = FileOffset
  629.           Chunk = readch('Temp', 10000)
  630.           EndPos = pos('Created', Chunk)
  631.           if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
  632.         end
  633.         if EndPos == 0 then PgmVersion = 'Final Writer - version unknown'
  634.         else do
  635.           StartPos = lastpos('Final', Chunk, EndPos)
  636.           EndPos = pos('00'x||'00'x, Chunk, StartPos)
  637.           PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
  638.         end
  639.       call close('Temp')
  640.       call open('Temp', Storage'FWC'App'VersionInfo.txt', 'W')
  641.         call writeln('Temp', PgmVersion)
  642.       call close('Temp')
  643.     end
  644.     else PgmVersion = PgmName" - can't find version info"
  645.   end
  646.  
  647.   return
  648. /**/
  649.  
  650. /***//*******  GetWidth (GW) Subroutine  ***********/
  651. GetWidth:
  652.   parse arg GW_ID
  653.  
  654.   if App = 'FW' then do
  655.     GETOBJECTCOORDS GW_ID
  656.     Parse Var result . . . GW_width .
  657.   end
  658.   else if App == 'PGS' then do
  659.     SELECTOBJECT OBJECTID GW_ID  WINDOW winName
  660.     GETOBJECT BOUNDINGBOX GW_Temp WINDOW winName
  661.     GW_width = GW_Temp.Right - GW_Temp.Left
  662.   end
  663.  
  664.   return GW_width
  665. /**/
  666.  
  667. /***//*******  LibVer (LV) Subroutine  *********/
  668. LibVer: /* Retrieve the version number of a library */
  669.   parse arg LV_libname
  670.   if right(LV_libname,8) ~= '.library' then LV_libname = LV_libname'.library'
  671.   address command 'version' 'libs:'LV_Libname '>env:LibVer'
  672.   if open('Temp', 'env:LibVer') then do
  673.     LV_libver = word(readln('Temp'), 2)
  674.     call close('Temp')
  675.   end
  676.   else LV_libver = 'unknown'
  677.   return LV_libver
  678. /**/
  679.  
  680. /***//*******  MemberID (MI) Subroutine  *********/
  681. MemberID:
  682.   parse arg MI_Member, MI_Array, MI_Count, MI_Start
  683.  
  684.   if MI_Start == 0 then MI_Count = MI_Count - 1
  685.   do MI_i = MI_Start to MI_Count
  686.     if upper(value(MI_Array'.'MI_i)) == upper(MI_Member) then return MI_i
  687.   end
  688.   return -1
  689. /**/
  690.  
  691. /***//*******  NameOnly (NO) Subroutine  ***********/
  692. NameOnly:
  693.   parse arg NO_fontname
  694.   return substr(NO_fontname, max(lastpos(':', NO_fontname), lastpos('/', NO_fontname)) + 1)
  695. /**/
  696.  
  697. /***//*******  OpenBusy (OB) Subroutine  ***********/
  698. OpenBusy:
  699.   parse arg OB_BusyTitle, OB_EventCount
  700.  
  701.   OB_ProgressGroup=bguivgroup(,
  702.         bguiinfo('OB_dummy',,'1B'x||'c'OB_BusyTitle)bguilayout(LGO_FixMinHeight,1)||,
  703.         bguiprogress('OB_prog2_',,0,OB_EventCount)||,
  704.         bguihgroup(,
  705.                 bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
  706.                 bguibutton('OB_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
  707.                 bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
  708.         ,,,,'W'),
  709.   ,-2,-2)
  710.  
  711.   OB_ProgressWindow = bguiwindow(PleaseWait$'...',OB_ProgressGroup,,2,,PubScreen)
  712.   if bguiwinopen(OB_ProgressWindow) = 0 then call Cleanup
  713.  
  714.   Progress = 0
  715.  
  716. return OB_ProgressWindow
  717. /**/
  718.  
  719. /***//*******  ParseVariables (PV) Subroutine  ***********/
  720. ParseVariables:
  721.   parse arg PV_Line
  722.  
  723.   PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
  724.   PV_VarString = ''
  725.   PV_Var.      = '00'x
  726.   PV_LongVar   = 4
  727.   PV_LIT       = ''
  728.   PV_Count     = 0
  729.  
  730.   do PV_i = 1 to words(PV_String)
  731.     PV_Word = word(PV_String, PV_i)
  732.     if pos(PV_Word'(', PV_Line) > 0 then iterate
  733.     if datatype(PV_Word) == 'CHAR' then do
  734.       if symbol(PV_Word) == 'LIT' then PV_LIT = PV_LIT''PV_Word', '
  735.       if symbol(PV_Word) == 'VAR' then do
  736.         PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
  737.         if PV_Var.PV_Word == '00'x then do
  738.           PV_Count = PV_Count + 1
  739.           PV_Var.PV_Count = PV_Word
  740.           PV_Var.PV_Word  = value(PV_Word)
  741.         end
  742.         if pos('.', PV_Word) > 0 then do
  743.           PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
  744.           do PV_j = 1 to words(PV_CompoundParts)
  745.             PV_Subword = word(PV_CompoundParts, PV_j)
  746.             if PV_Var.PV_SubWord == '00'x then do
  747.               PV_Count = PV_Count + 1
  748.               PV_Var.PV_Count = PV_SubWord
  749.               if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord  = 'LIT'
  750.               else PV_Var.PV_SubWord  = value(PV_SubWord)
  751.             end
  752.           end
  753.         end
  754.       end
  755.     end
  756.   end
  757.  
  758.   do PV_i = 1 to PV_Count
  759.     PV_Word = PV_Var.PV_i
  760.     if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
  761.     PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
  762.     PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
  763.   end
  764.  
  765.   if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString
  766.  
  767.   return PV_VarString
  768. /**/
  769.  
  770. /***//*******  PathPart (PP) Subroutine ***********/
  771. PathPart:
  772.   parse arg PP_FileWithPath
  773.   return left(PP_FileWithPath, max(lastpos(':', PP_FileWithPath), lastpos('/', PP_FileWithPath)))
  774. /**/
  775.  
  776. /***//*******  PrintText (PT) Subroutine  ***********/
  777. PrintText:
  778.   parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text
  779.  
  780.   if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
  781.   else PT_Font = Bold.PT_FontType
  782.  
  783.   if App == 'FW' then do
  784.     if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
  785.     PT_Top = PT_Top + TextAdj * Height.PT_FontType
  786.     TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
  787.     DRAWTEXTBLOCK 1 PT_Left PT_Top PT_Text; PT_id = result
  788.   end
  789.   else if App == 'PGS' then do
  790.     DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
  791.     SELECTTEXT AT PT_Left PT_Top WINDOW winName
  792.     BEGINCOMMANDCAPTURE
  793.       SETLEADING RELATIVE 100
  794.       SETTYPESIZE FSize.PT_FontType WINDOW winName
  795.       SETTYPEWIDTH PT_Width WINDOW winName
  796.       SETFONT PT_Font WINDOW winName
  797.       SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
  798.     ENDCOMMANDCAPTURE
  799.     if pos('"', PT_Text) > 0 then do
  800.       call open('IFile', Storage'Text2Insert.txt', 'W')
  801.         call WriteLn('IFile', PT_Text)
  802.       call close('IFile')
  803.       INSERTTEXT FILE Storage'Text2Insert.txt' FILTER ASCII WINDOW winName
  804.     end
  805.     else INSERT '"'PT_Text'"' WINDOW winName
  806.   end
  807.   return PT_id
  808. /**/
  809.  
  810. /***//*******  ProcessEvent (PE) Subroutine  ***********/
  811. ProcessEvent:
  812.   Day1 = ''
  813.   Day2 = ''
  814.   EnteredLine = 1
  815.   Options = ''
  816.   EnteredEvent = ''
  817.   Box = 0
  818.   Weekly = 0
  819.   WindowRefreshed = 0
  820.  
  821.   if EventData == 0 then call CleanUp
  822.   call openv('EventData')
  823.     do until eofv('EventData')
  824.       PE_Ln = readvln('EventData')
  825.       interpret strip(word(PE_Ln, 1))' = strip(subword(PE_Ln, 3))'
  826.     end
  827.   call closev('EventData')
  828.  
  829.   Event. = ''
  830.   if EventType == Event$ then do
  831.     Event.0   = 1
  832.     Event.1   = EventData
  833.     EventFile = ''
  834.   end
  835.   else do
  836.     EventFile = EnteredEvent
  837.     RootDay = ConvertDay(EnteredDay1)
  838.  
  839.     call open('EventFile', EventFile)
  840.       EventCount = 1
  841.       do until eof('EventFile')
  842.         Ln = ReadLn('EventFile')
  843.         if eof('EventFile') == 0 then do
  844.           if left(strip(Ln), 2) == '/*' then iterate
  845.           if Ln == '' then do
  846.             EventCount = EventCount + 1
  847.             iterate
  848.           end
  849.           Event.EventCount = Event.EventCount''Ln||'0a'x
  850.         end
  851.       end
  852.       Event.0 = EventCount
  853.     call close('EventFile')
  854.   end
  855.  
  856.   if Event.0 > 1 then Req = OpenBusy(ProcessEvents$'...', Event.0)
  857.   if App == 'PGS' then do
  858.     REFRESH OFF ALL
  859.   end
  860.   do EC = 1 to Event.0
  861.     if Req ~= 0 then call UpdateBusy(Req, 1)
  862.     Box    = 0
  863.     Weekly = 0
  864.     EnteredFont = Font.Highlight
  865.     EnteredSize = FSize.Highlight
  866.     EnteredDay1 = ''
  867.     EnteredDay2 = ''
  868.     EnteredLine = ''
  869.     EnteredEvent = ''
  870.     Options = ''
  871.     BoxColor = ''
  872.     TextColor = ''
  873.  
  874.     if Event.EC == '' then iterate
  875.     call openv('Event.EC')
  876.       do until eofv('Event.EC')
  877.         PE_Ln = readvln('Event.EC')
  878.         PE_Variable = upper(strip(word(PE_Ln, 1)))
  879.         select
  880.           when PE_Variable == 'FONT' then PE_Variable = 'EnteredFont'
  881.           when PE_Variable == 'SIZE' then PE_Variable = 'EnteredSize'
  882.           when PE_Variable == 'START' then PE_Variable = 'EnteredDay1'
  883.           when PE_Variable == 'END' then PE_Variable = 'EnteredDay2'
  884.           when PE_Variable == 'LINE' then PE_Variable = 'EnteredLine'
  885.           when PE_Variable == 'EVENT' then PE_Variable = 'EnteredEvent'
  886.           otherwise nop
  887.         end
  888.         interpret PE_Variable'= strip(subword(PE_Ln, 3))'
  889.       end
  890.     call closev('Event.EC')
  891.     EnteredFont = strip(EnteredFont, 'B', '"'||"'")
  892.     TextColor   = strip(TextColor, 'B', '"'||"'")
  893.     BoxColor    = strip(BoxColor, 'B', '"'||"'")
  894.     Options     = compress(upper(strip(Options, 'B', ' "'||"'")))
  895.  
  896.     if App == 'FW' then EnteredSize = max(trunc(EnteredSize), 4)
  897.  
  898.     FontInfo = compress(EnteredFont''EnteredSize, '. /:')
  899.     if FontKnown.FontInfo == '' then do
  900.       HighestFont = HighestFont + 1
  901.       FontKnown.FontInfo = HighestFont
  902.       Font.HighestFont = EnteredFont
  903.       FSize.HighestFont = EnteredSize
  904.       Height.HighestFont = GetHeight(HighestFont) * Leading/100
  905.     end
  906.     CurrentFont = FontKnown.FontInfo
  907.  
  908.     If EnteredDay2 == "" then EnteredDay2 = EnteredDay1
  909.     If EnteredLine == '' then EnteredLine = 1
  910.     if BoxColor    == '' then BoxColor = Background.AddEvent
  911.     if TextColor   == '' then TextColor = Color.AddEvent
  912.  
  913.     if EventType = Event$ then do
  914.       EnteredDay1 = ConvertDay(EnteredDay1)
  915.       EnteredDay2 = ConvertDay(EnteredDay2)
  916.     end
  917.     else do
  918.       EnteredDay1 = RootDay + EnteredDay1
  919.       EnteredDay2 = RootDay + EnteredDay2
  920.     end
  921.     If EnteredDay1 > EnteredDay2 then Do
  922.       TempDate = EnteredDay1
  923.       EnteredDay1 = EnteredDay2
  924.       EnteredDay2 = TempDate
  925.     End
  926.  
  927.     if pos('B', Options) ~= 0 then Box = 1
  928.     if pos('W', Options) ~= 0 then Weekly = 1
  929.     if pos('2', Options) ~= 0 then Weekly = 2
  930.  
  931.     /* Process Event */
  932.     if App == 'PGS' then REFRESH OFF ALL
  933.     do until Weekly = 0
  934.       Event = EnteredEvent
  935.       Line  = EnteredLine
  936.       Day1  = EnteredDay1
  937.       Day2  = EnteredDay2
  938.       Text. = ''
  939.  
  940.       if Day1 > MaxDate then do
  941.         Weekly = 0
  942.         iterate
  943.       end
  944.       if Day2 > MaxDate then Day2 = MaxDate
  945.  
  946.       If Day1 ~= Day2 then Box = 1
  947.  
  948.       LineCount = 0
  949.       Do until Day1 > Day2
  950.         Day1Row = trunc((Day1 + StartDate - 1) / 7)
  951.         Day2Row = trunc((Day2 + StartDate - 1) / 7)
  952.         Day1Column = (Day1 + StartDate) - 7 * Day1Row - 1
  953.         Day2Column = (Day2 + StartDate) - 7 * Day2Row - 1
  954.  
  955.         if Day1Row == Day2Row then DaySpan = Day2Column - Day1Column + 1
  956.         else DaySpan = 7 - Day1Column
  957.         if Day1 < 1 then CalDate = MonthLength.PrevMonth + Day1
  958.         else if Day1 > MonthLength.Month then CalDate = Day1 - MonthLength.Month
  959.         else CalDate = Day1
  960.         Select
  961.           when CalDate < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
  962.           when CalDate < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
  963.           otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
  964.         end
  965.         HighlightOffset = (1 - Box) * HighlightOffset * (Line * Height.Highlight < Height.Date * TextBase)
  966.         If Day1Row < 5 then BoxTop = CalTop + Day1Row * BoxHeight
  967.         else BoxTop = CalTop + 4.5 * BoxHeight
  968.  
  969.         LeftEdge = Margin.Left + Day1Column * BoxWidth + DateOffset + HighlightOffset
  970.         if event ~= '' then do
  971.           Textline = 0
  972.           Text.    = ''
  973.           Text.Textline = event
  974.  
  975.           /* Accomodate user line breaks */
  976.           do until LineBreak = 0
  977.             LineBreak = pos('//', Text.Textline)
  978.             if LineBreak > 0 then do
  979.               Nextline = Textline + 1
  980.               Text.Nextline = substr(Text.Textline, LineBreak + 2)
  981.               Text.Textline = left(Text.Textline, LineBreak - 1)
  982.               Textline = Nextline
  983.             end
  984.           end
  985.           Textline = 0
  986.  
  987.           /* Fit line(s) into allowable space */
  988.           do until Text.Nextline == ''
  989.             Nextline = Textline + 1
  990.             if Box == 1 | Textline == 0 then Indent.Textline = 0
  991.             else Indent.Textline = 3 * DateOffset
  992.             AllowedWidth = DaySpan * BoxWidth - 2 * DateOffset - Indent.Textline - HighlightOffset - 2 * DateOffset * Box
  993.             AllowedBoxWidth = AllowedWidth + 2 * DateOffset
  994.             if left(Text.Textline, length(TabSub)) == TabSub then do
  995.               Indent.Textline = TabFactor * DateOffset
  996.               Text.Textline = substr(Text.Textline, length(TabSub) + 1)
  997.             end
  998.  
  999.             if App == 'FW' & length(Text.Textline) > 37 then do
  1000.               Wordbreak = lastpos(' ', Text.Textline, 37)
  1001.               Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1002.               Text.Textline = strip(left(Text.Textline, Wordbreak))
  1003.             end
  1004.             ID = PrintText(1, 1, CurrentFont, 'N', TextColor, Width.CurrentFont, Text.Textline)
  1005.             if App == 'FW' then redraw
  1006.             TextWidth.Textline = GetWidth(ID)
  1007.             if App == 'FW' then DELETEOBJECT ID
  1008.             else if App == 'PGS' then do
  1009.               SELECTOBJECT OBJECTID ID WINDOW winName
  1010.               DELETEOBJECT OBJECTID ID WINDOW winName
  1011.             end
  1012.  
  1013.             NeededCompression.Textline = min(1, AllowedWidth/TextWidth.Textline)
  1014.             TextWidth.Textline = TextWidth.Textline * NeededCompression.Textline
  1015.             if (NeededCompression.Textline < MinWidth/100) & (Words(Text.Textline) > 1) then do
  1016.               /* Move last word to next line */
  1017.               Wordbreak     = lastpos(' ', Text.Textline)
  1018.               Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1019.               Text.Textline = strip(left(Text.Textline, Wordbreak))
  1020.             end
  1021.             else if Text.Nextline ~= '' then Textline = Textline + 1
  1022.           End
  1023.           LineCount = Textline
  1024.         end
  1025.  
  1026.         if Box then call DrawBox(LeftEdge, BoxTop + Line * Height.Highlight, AllowedBoxWidth, Height.CurrentFont * (LineCount + 1), 'HL', Line.AddEvent, 1, BoxColor, 100)
  1027.         if event ~= '' then
  1028.           do i = 0 to LineCount
  1029.             Text.Top = BoxTop + (Line + i) * Height.Highlight
  1030.             if Box == 0 then Text.Left = LeftEdge + Indent.i
  1031.             else Text.Left = LeftEdge + (AllowedBoxWidth - TextWidth.i) / 2
  1032.             TextWidth = NeededCompression.i * Width.CurrentFont
  1033.             if App == 'FW' then TextWidth = min(max(trunc(TextWidth), 4), 255)
  1034.             call PrintText(Text.Left, Text.Top, CurrentFont, 'N', TextColor, TextWidth, Text.i)
  1035.           end
  1036.  
  1037.         Day1 = Day1 + DaySpan
  1038.         if Day1 > Day2 then leave
  1039.         else if trunc((Day1 + StartDate - 1) / 7) > 4 & Day2 > MonthLength.Month then Day2 = Day1
  1040.       end
  1041.  
  1042.       if Weekly == 1 then do
  1043.         EnteredDay1 = EnteredDay1 + 7
  1044.         EnteredDay2 = EnteredDay2 + 7
  1045.       end
  1046.       else if Weekly == 2 then do
  1047.         EnteredDay1 = EnteredDay1 + 14
  1048.         EnteredDay2 = EnteredDay2 + 14
  1049.       end
  1050.     end
  1051.  
  1052.     if App == 'FW' then redraw
  1053.     else if App == 'PGS' then SELECTOBJECT None WINDOW winName
  1054.   end
  1055.  
  1056.   if Req ~= 0 then call bguiwinclose(Req)
  1057.  
  1058.   if App == 'PGS' then do
  1059.     REFRESH ON ALL
  1060.     REFRESHWINDOW WINDOW winName
  1061.     WindowRefreshed = 1
  1062.   end
  1063.  
  1064. return
  1065. /**/
  1066.  
  1067. /***//*******  Syntax () Subroutine  ***********/
  1068. Syntax:
  1069.   signal off syntax
  1070.  
  1071.   ErrorLine  = SIGL
  1072.   SourceLine = strip(SourceLine(ErrorLine))
  1073.  
  1074.   call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
  1075.   call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
  1076.   call AddMsg('E', ParseVariables(SourceLine))
  1077.  
  1078.   call Cleanup
  1079.   exit
  1080. /**/
  1081.  
  1082. /***//*******  TranslationStrings () Subroutine  ***********/
  1083. TranslationStrings:
  1084. Backgrounds$    = 'Backgrounds'
  1085. Biweekly$       = 'Biweekly'
  1086. Bottom$         = 'Bottom'
  1087. BoxColor$       = 'Box:'
  1088. BoxDates$       = 'Box Dates'
  1089. Boxed$          = '_Boxed:'
  1090. Calendar$       = 'Calendar'
  1091. Cancel$         = '_Cancel'
  1092. CantFind$       = "can't be found"
  1093. CantMatch$      = "The export file can't be the"||'0a'x||"same as the preferences file"
  1094. CantOpen$       = "can't be opened"
  1095. Center$         = 'Center'
  1096. Clear$          = 'Clear'
  1097. Colors$         = 'Colors'
  1098. Critical$       = 'Critical error'
  1099. DailyColors$    = 'Use daily colors'
  1100. Easter$         = 'Easter'
  1101. End$            = 'End:'
  1102. EnterEvent$     = 'You must enter an event...'
  1103. EnterEventInfo$ = 'Enter event information:'
  1104. EnterStartdate$ = 'You must enter a start date...'
  1105. Event$          = 'Event:'
  1106. Export$         = 'E_xport'
  1107. ExportFile$     = 'Select export file:'
  1108. Exporting$      = 'Exporting'
  1109. Extended$       = 'Extended'
  1110. File$           = 'File:'
  1111. Font$           = 'Font:'
  1112. Fonts$          = 'Fonts'
  1113. ForDetails$     = 'for details'
  1114. ForwardContent$ = 'Forward contents of output to'
  1115. ForwardLog$     = 'Forward log file to'
  1116. Frequency$      = 'Frequency:'
  1117. GeneratingM$    = 'Generating %s %s calendar'
  1118. GeneratingY$    = 'Generating %s calendar'
  1119. GenMVars        = 'Month.Month EnteredYear'
  1120. GenYVars        = 'EnteredYear'
  1121. Highlights$     = 'Highlights'
  1122. Images$         = 'Images'
  1123. Julian$         = 'Julian'
  1124. JulJulLeft$     = 'Jul/Jul Left'
  1125. JulLeft$        = 'Jul Left'
  1126. Left$           = 'Left'
  1127. Line$           = '_Line:'
  1128. Load$           = '_Load'
  1129. MatchColors$    = 'Date Color = Highlight Color'
  1130. MiniCals$       = 'MiniCals'
  1131. MiscVar$        = 'Miscellaneous Variables'
  1132. Monthly$        = '_Monthly'
  1133. MustUse$        = "You must use the gadget to"||'0a'x||"the right to select a font."
  1134. Noncritical$    = 'Noncritical warning'
  1135. None$           = 'None'
  1136. NotClear$       = '<'Clear$'> can only be used for Background. variables...'
  1137. Notice$         = 'notice'
  1138. OK$             = '_OK'
  1139. Once$           = 'Once'
  1140. Options$        = 'Options'
  1141. OptLayout$      = 'Options & Layout'
  1142. OrientMarg$     = 'Orientation & Margins'
  1143. Phases$         = 'Phases'
  1144. PleaseWait$     = 'Please wait'
  1145. PrepReq$        = 'Preparing requester'
  1146. ProcessEvents$  = 'Processing events'
  1147. Reset$          = '_Reset'
  1148. Right$          = 'Right'
  1149. RiseSet$        = 'Rise/Set'
  1150. See$            = 'see'
  1151. SeeOutput$      = 'see the output above for details'
  1152. SeeShell$       = 'see the shell output for details'
  1153. SelectFile$     = 'Select data file:'
  1154. SelectFont$     = 'Select font:'
  1155. Start$          = 'Start:'
  1156. Sunrise$        = 'Sunrise'
  1157. Sunset$         = 'Sunset'
  1158. Tall$           = 'Tall'
  1159. TextColor$      = 'Text:'
  1160. Top$            = 'Top'
  1161. Unable$         = 'if you are unable to resolve the problem.'
  1162. VarGUITitle$    = 'Set desired variables:'
  1163. Variables$      = 'Variables'
  1164. Weekly$         = 'Weekly'
  1165. Weeknumber$     = 'Weeknumber'
  1166. WholeYear$      = 'Whole _Year'
  1167. Wide$           = 'Wide'
  1168.  
  1169. January$   = 'January'
  1170. February$  = 'February'
  1171. March$     = 'March'
  1172. April$     = 'April'
  1173. May$       = 'May'
  1174. June$      = 'June'
  1175. July$      = 'July'
  1176. August$    = 'August'
  1177. September$ = 'September'
  1178. October$   = 'October'
  1179. November$  = 'November'
  1180. December$  = 'December'
  1181.  
  1182. Sunday$    = 'Sunday'
  1183. Monday$    = 'Monday'
  1184. Tuesday$   = 'Tuesday'
  1185. Wednesday$ = 'Wednesday'
  1186. Thursday$  = 'Thursday'
  1187. Friday$    = 'Friday'
  1188. Saturday$  = 'Saturday'
  1189. return 0
  1190. /**/
  1191.  
  1192. /***//*******  UpdateBusy (UB) Subroutine  ***********/
  1193. UpdateBusy:
  1194.   parse arg UB_ReqWin, UB_ProgressMade
  1195.  
  1196.   if Req ~= 0 then do
  1197.     Progress = Progress + UB_ProgressMade
  1198.  
  1199.     call bguiset(obj.OB_prog2_,UB_ReqWin,PROGRESS_Done,Progress)
  1200.     if bguiwinevent(UB_ReqWin,'ID') == id.OB_cancel_ then call Cleanup
  1201.   end
  1202.  
  1203.   return
  1204. /**/
  1205.  
  1206. /***//*******  VIO Routines () Subroutine  ***********/
  1207. /***//** OpenV() **/
  1208. OpenV:
  1209.   parse arg VIO_Variable
  1210.  
  1211.   if Open.VIO_Variable ~= 1 then do
  1212.     Open.VIO_Variable = 1
  1213.     Pointer.VIO_Variable = 1
  1214.     EOF.VIO_Variable = 0
  1215.     return 1
  1216.   end
  1217.   else return 0
  1218. /**/
  1219.  
  1220. /***//** CloseV() **/
  1221. CloseV:
  1222.   parse arg VIO_Variable
  1223.  
  1224.   If Open.VIO_Variable == 0 then return 0
  1225.   Open.VIO_Variable = 0
  1226.   return 1
  1227. /**/
  1228.  
  1229. /***//** SeekV() **/
  1230. SeekV:
  1231.   parse arg VIO_Variable, VIO_Offset, VIO_Anchor
  1232.  
  1233.   if Open.VIO_Variable == 1 then do
  1234.     VIO_Anchor = upper(left(VIO_Anchor, 1))
  1235.  
  1236.     VIO_Value = Value(VIO_Variable)
  1237.     select
  1238.       when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
  1239.       when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
  1240.       otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
  1241.     end
  1242.  
  1243.     if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
  1244.     return Pointer.VIO_Variable
  1245.   end
  1246.   else return 0
  1247. /**/
  1248.  
  1249. /***//** ReadVCh() **/
  1250. ReadVCh:
  1251.   parse arg VIO_Variable, VIO_Length
  1252.  
  1253.   if VIO_Length == '' then VIO_Length = 1
  1254.  
  1255.   if Open.VIO_Variable == 1 then do
  1256.     if EOF.VIO_Variable == 0 then do
  1257.       VIO_Value = Value(VIO_Variable)
  1258.       VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
  1259.       Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
  1260.       if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
  1261.       else EOF.VIO_Variable = 0
  1262.     end
  1263.     else VIO_Ret = ''
  1264.   end
  1265.   else VIO_Ret = ''
  1266.  
  1267.   return VIO_Ret
  1268. /**/
  1269.  
  1270. /***//** ReadVLn(RV) **/
  1271. ReadVLn:
  1272.   parse arg VIO_Variable, VIO_Count, VIO_SepChar
  1273.  
  1274.   if VIO_Count == '' then VIO_Count = 1
  1275.   if VIO_SepChar == '' then VIO_SepChar = '0a'x
  1276.  
  1277.   if Open.VIO_Variable == 1 then do
  1278.     VIO_Value = Value(VIO_Variable)
  1279.     VIO_Ret   = ''
  1280.     do VIO_i = 1 to VIO_Count
  1281.       VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
  1282.       if VIO_LF > 0 then do
  1283.         VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
  1284.         Pointer.VIO_Variable = VIO_LF + 1
  1285.         if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
  1286.         else EOF.VIO_Variable = 0
  1287.       end
  1288.       else do
  1289.         if Pointer.VIO_Variable < length(VIO_Value) then do
  1290.           VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
  1291.           Pointer.VIO_Variable = length(VIO_Value) + 1
  1292.           EOF.VIO_Variable = 1
  1293.         end
  1294.       end
  1295.       if EOF.VIO_Variable == 1 then leave
  1296.       if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
  1297.     end
  1298.   end
  1299.   else VIO_Ret = ''
  1300.  
  1301.   return VIO_Ret
  1302. /**/
  1303.  
  1304. /***//** WriteVCh() **/
  1305. WriteVCh:
  1306.   parse arg VIO_Variable, VIO_String, VIO_Option
  1307.  
  1308.   VIO_Value  = Value(VIO_Variable)
  1309.   VIO_Option = upper(left(VIO_Option, 1))
  1310.   VIO_Length = length(VIO_Value)
  1311.   if VIO_Option == 'C' then do
  1312.     VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
  1313.     Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
  1314.   end
  1315.   else if VIO_Option == 'B' then do
  1316.     VIO_Value = VIO_String''VIO_Value
  1317.     Pointer.VIO_Variable = length(VIO_String) + 1
  1318.   end
  1319.   else do
  1320.     VIO_Value = VIO_Value''VIO_String
  1321.     Pointer.VIO_Variable = length(VIO_Value)
  1322.   end
  1323.   interpret VIO_Variable'= VIO_Value'
  1324.   if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
  1325.   else VIO_Ret = 0
  1326.  
  1327.   return VIO_Ret
  1328. /**/
  1329.  
  1330. /***//** WriteVLn() **/
  1331. WriteVLn:
  1332.   parse arg VIO_Variable, VIO_String, VIO_Option
  1333.  
  1334.   return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
  1335. /**/
  1336.  
  1337. /***//** EOFV() **/
  1338. EOFV:
  1339.   parse arg VIO_Variable
  1340.  
  1341.   if Open.VIO_Variable == 1 then return EOF.VIO_Variable
  1342.   else return 1
  1343. /**/
  1344. /**/
  1345.  
  1346. /***//*******  SetVariables Subroutine  ***********/
  1347. SetVariables:
  1348.  
  1349. /***//* Initialize Variables */
  1350.   AddEventRows    = 9
  1351.   ChangesFile     = 'FWC.dat'
  1352.   DataFile        = ''
  1353.   Date            = 0
  1354.   DoShanghai      = 1
  1355.   esc             = "1B"x
  1356.   EventFile       = ''
  1357.   EventKey        = 'E'
  1358.   FontKnown.      = ''
  1359.   FSize.          = 10
  1360.   HighestFont     = 5
  1361.   Highlight       = 5
  1362.   Leading         = 100
  1363.   MinWidth        = 80
  1364.   PatVar          = '#?.data'
  1365.   PrefsFile       = ''
  1366.   Req             = 0
  1367.   StartWeek       = 0
  1368.   Storage         = 'RAM:FWC/'
  1369.   TabFactor       = 3
  1370.   TabSub          = '/~'
  1371.   Width.          = 100
  1372.  
  1373.   if App == 'FW' then DefaultFont = "SoftSans"
  1374.   else if App == 'PGS' then DefaultFont = 'PageStream-Normal'
  1375.  
  1376.   TextAdj         = 0.77
  1377.   WTextArea       = 0.20  /* fraction of print height used for top of calendar (Wide) */
  1378.   TTextArea       = 0.15  /* fraction of print height used for top of calendar (Tall) */
  1379.   DateOffset      = 0.02  /* fraction of box width to offset dates from edge of box   */
  1380.  
  1381.   D.0 = 'Sunday'
  1382.   D.1 = 'Monday'
  1383.   D.2 = 'Tuesday'
  1384.   D.3 = 'Wednesday'
  1385.   D.4 = 'Thursday'
  1386.   D.5 = 'Friday'
  1387.   D.6 = 'Saturday'
  1388.  
  1389.   MonthLength.1    = 31
  1390.   MonthLength.2    = 28
  1391.   MonthLength.3    = 31
  1392.   MonthLength.4    = 30
  1393.   MonthLength.5    = 31
  1394.   MonthLength.6    = 30
  1395.   MonthLength.7    = 31
  1396.   MonthLength.8    = 31
  1397.   MonthLength.9    = 30
  1398.   MonthLength.10   = 31
  1399.   MonthLength.11   = 30
  1400.   MonthLength.12   = 31
  1401.  
  1402.   call TranslationStrings
  1403. /**/
  1404.  
  1405.   ProcessNow = 'DoShanghai Storage PrefsFile'
  1406.  
  1407.   if exists(ScriptDir''ChangesFile) then do
  1408.     call open('DataFile', ScriptDir''ChangesFile)
  1409.       do until eof('DataFile')
  1410.         Ln = ReadLn('DataFile')
  1411.         if pos(upper(word(Ln, 1)), upper(ProcessNow)) ~= 0 then interpret Ln
  1412.         else if right(word(Ln, 1), 1) == '$' then interpret Ln
  1413.         else if pos('End Pass One', Ln) > 0 then leave
  1414.       end
  1415.     call close('DataFile')
  1416.   end
  1417.  
  1418.   if (PrefsFile ~= '') & (exists(PrefsFile)) then do
  1419.     if open('DataFile', PrefsFile) then do
  1420.       do until eof('DataFile')
  1421.         Ln = ReadLn('DataFile')
  1422.         Var = upper(word(Ln, 1))
  1423.         if right(Var, 1) == '$' then interpret Ln
  1424.         else if pos('/* End Pass One', Ln) > 0 then leave
  1425.       end
  1426.       call close('DataFile')
  1427.     end
  1428.     Month.1  = January$
  1429.     Month.2  = February$
  1430.     Month.3  = March$
  1431.     Month.4  = April$
  1432.     Month.5  = May$
  1433.     Month.6  = June$
  1434.     Month.7  = July$
  1435.     Month.8  = August$
  1436.     Month.9  = September$
  1437.     Month.10 = October$
  1438.     Month.11 = November$
  1439.     Month.12 = December$
  1440.   end
  1441.  
  1442.   call makedir(left(Storage, length(Storage) - 1))
  1443.   call GetLogInfo
  1444.  
  1445.   if App == 'FW' then do
  1446.     call open('FWPrefs', CurrentDir'FWFiles/FW.Prefs')
  1447.       FWPrefs = readch('FWPrefs', 65535)
  1448.     call close('FWPrefs')
  1449.     ColorTable = pos('SWCL', FWPrefs) + 12
  1450.     EndTable = pos('STUP', FWPrefs)
  1451.     ColorCount = 0
  1452.     Do CTPos = ColorTable to EndTable by 20
  1453.       ColorRegister = c2x(substr(FWPrefs, CTPos - 3, 3))
  1454.       ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
  1455.       if ColorRegister = '000000' then Black$ = ColorList.ColorCount
  1456.       if ColorRegister = 'FFFFFF' then White$ = ColorList.ColorCount
  1457.       ColorCount = ColorCount + 1
  1458.     end
  1459.     ColorList.ColorCount = '<'Clear$'>'
  1460.     ColorCount = ColorCount + 1
  1461.     ColorList.COUNT = ColorCount
  1462.     if symbol('Black$') == 'LIT' then do
  1463.       call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
  1464.       Black$ = ColorList.0
  1465.     end
  1466.     if symbol('White$') == 'LIT' then do
  1467.       call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
  1468.       White$ = ColorList.1
  1469.     end
  1470.   end
  1471.   else if App == 'PGS' then do
  1472.     GETFONTLIST FontList
  1473.     FontList.COUNT = result
  1474.  
  1475.     call open('PGSColors', CurrentDir''word(PgmVersion, 1)'.colors')
  1476.       PGSColors = readch('PGSColors', 65535)
  1477.     call close('PGSColors')
  1478.     ColorCount = 0
  1479.     StartTag = pos('TG'||'00'x, PGSColors)
  1480.     do while StartTag ~= 0
  1481.       Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
  1482.       AccentMarker = pos(d2c(129), Color)
  1483.       do while AccentMarker > 0
  1484.         Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
  1485.         AccentMarker = pos(d2c(129), Color)
  1486.       end
  1487.       ColorList.ColorCount = Color
  1488.       ColorCount = ColorCount + 1
  1489.       StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
  1490.     end
  1491.     ColorList.ColorCount = '<'Clear$'>'
  1492.     ColorCount = ColorCount + 1
  1493.     ColorList.COUNT = ColorCount
  1494.     White$ = ColorList.0
  1495.     Black$ = ColorList.1
  1496.   end
  1497.   TextColorList.Count = ColorList.COUNT - 1
  1498.   do i = 0 to TextColorList.Count - 1
  1499.     TextColorList.i = ColorList.i
  1500.   end
  1501.  
  1502.   Color.          = Black$
  1503.   Line.           = Black$
  1504.   Background.     = White$
  1505.  
  1506.   AppScreen = ''
  1507.   DefPubScreen = ''
  1508.   if RexxTricks == 1 then do
  1509.     if (pubscreenlist('ScreenList') > 0) then do
  1510.       do i = 1 to ScreenList.0
  1511.         if pos(AppName, upper(ScreenList.i)) > 0 then do
  1512.           AppScreen = ScreenList.i
  1513.           leave
  1514.         end
  1515.       end
  1516.     end
  1517.   end
  1518.  
  1519.  
  1520.   /**** Read user variables ****/
  1521.   if App == 'FW' then do
  1522.     FIRSTOBJECT; TempDateID = result
  1523.     do forever
  1524.       if TempDateID == 0 then do
  1525.         call AddMsg('E', 'Unable to find FWC date string.')
  1526.         call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  1527.         call Cleanup
  1528.       end
  1529.       GETOBJECTTYPE TempDateID; ObjectType = result
  1530.       if ObjectType == 7 then do
  1531.         GETTEXTBLOCKTEXT TempDateID; TempDate = result
  1532.         if (left(TempDate, 3) == 'FWC') & (datatype(substr(TempDate, 4, 8)) == 'NUM') then leave
  1533.       end
  1534.       NEXTOBJECT TempDateID; TempDateID = result
  1535.     end
  1536.     do while right(TempDate, 1) == '|'
  1537.       StartObj = pos('|', TempDate)
  1538.       NextObj = strip(substr(TempDate, StartObj), 'B', '|')
  1539.       GETTEXTBLOCKTEXT NextObj; TempDate = left(TempDate, StartObj - 1)''result
  1540.     end
  1541.     PrefsFile = substr(TempDate, 12)
  1542.     TempDate = substr(TempDate, 4, 8)
  1543.   end
  1544.   else if App = 'PGS' then do
  1545.     CURRENTWINDOW; winName = '"'RESULT'"'
  1546.     SELECTTEXT at 0 0 WINDOW winName
  1547.     SELECTTEXT ALL WINDOW winName
  1548.     EXPORTTEXT AMIGA FILE Storage"TempDate.txt" FILTER "ASCII" STATUS FORCE
  1549.     if exists(Storage"TempDate.txt") then do
  1550.       open(TDFile, Storage"TempDate.txt")
  1551.         TempDate = ReadLn(TDFile)
  1552.       close(TDFile)
  1553.     end
  1554.     if (left(TempDate, 3) ~= 'FWC') | (datatype(substr(TempDate, 4, 8)) ~= 'NUM') then do
  1555.       call AddMsg('E', 'Unable to find FWC date string.')
  1556.       call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  1557.       call Cleanup
  1558.     end
  1559.     else do
  1560.       PrefsFile = substr(TempDate, 12)
  1561.       TempDate = substr(TempDate, 4, 8)
  1562.     end
  1563.   end
  1564.   if PrefsFile == '' then do
  1565.     if exists(ScriptDir''FWCData) then PrefsFile = ScriptDir''FWCData
  1566.     else PrefsFile = 'Default'
  1567.   end
  1568.  
  1569.   call open('Temp', FullCallPath)
  1570.     FileOffset = 40000
  1571.     call seek('Temp', FileOffset, 'B')
  1572.     do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  1573.       PrevOffset = FileOffset
  1574.       Chunk = readch('Temp', 65535)
  1575.       EndPos = pos('VarList:'||'0a'x, Chunk)
  1576.       if EndPos == 0 then FileOffset = seek('Temp', -10, 'C')
  1577.     end
  1578.     call seek('Temp', FileOffset + EndPos + 8, 'B')
  1579.     DefaultVariables = readch('Temp', 65535)
  1580.   call close('Temp')
  1581.   call openv('DefaultVariables')
  1582.     do forever
  1583.       CD_VarLine = strip(readvln('DefaultVariables'))
  1584.       if CD_VarLine == 'return' then leave
  1585.       if CD_VarLine == '' then iterate
  1586.       interpret CD_VarLine
  1587.     end
  1588.   call closev('DefaultVariables')
  1589.  
  1590.   if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
  1591.     if open('UserFile', PrefsFile) then do
  1592.       UserFile = readch('UserFile', 65535)
  1593.       call close('UserFile')
  1594.       call openv('UserFile')
  1595.         do until eofv('UserFile')
  1596.           CD_VarLine = strip(ReadvLn('UserFile'))
  1597.           CD_VarName = upper(strip(word(CD_VarLine, 1)))
  1598.           if left(CD_VarLine, 15) == '/* End Pass One' then leave
  1599.           if (left(CD_VarLine, 2) == '/*') |,
  1600.              (CD_VarName == 'DOSHANGHAI') |,
  1601.              (CD_VarLine == '') |,
  1602.              (upper(left(CD_VarLine, 11)) == 'IMAGECLASS.') then iterate
  1603.           else interpret CD_VarLine
  1604.         end
  1605.       call closev('UserFile')
  1606.     end
  1607.   end
  1608.   drop Orientation
  1609.  
  1610.   if RexxTricks == 1 then do
  1611.     if DoShanghai ~= 0 then PubScreen = AppScreen
  1612.     else PubScreen = DefPubScreen
  1613.   end
  1614.  
  1615.   Type.0    = Event$
  1616.   Type.1    = File$
  1617.   FSize.4pt = 4
  1618.  
  1619.   do i = 0 to 6
  1620.     val = i - StartWeek
  1621.     if val < 0 then val = 7 + val
  1622.     interpret 'Day.'D.i '=' val
  1623.     interpret 'Day.val = 'D.i'$'
  1624.   end
  1625.  
  1626.   Month.1  = January$
  1627.   Month.2  = February$
  1628.   Month.3  = March$
  1629.   Month.4  = April$
  1630.   Month.5  = May$
  1631.   Month.6  = June$
  1632.   Month.7  = July$
  1633.   Month.8  = August$
  1634.   Month.9  = September$
  1635.   Month.10 = October$
  1636.   Month.11 = November$
  1637.   Month.12 = December$
  1638.  
  1639.   do i = 1 to 12
  1640.     AbbrMonth.i  = left(Month.i, 3)
  1641.   end
  1642.  
  1643.   if App == 'FW' then do
  1644.     TextBase = TextAdj
  1645.     do i = 0 to 5 by 5
  1646.       if Font.i == NameOnly(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
  1647.       if ~exists(Font.i) then do
  1648.         call AddMsg('W', NameOnly(Font.i)" can't be found; "DefaultFont" used instead.")
  1649.         Font.i = DefaultFont
  1650.       end
  1651.     end
  1652.     GETPAGESETUP ORIENT; FWC_Orientation = result
  1653.     if FWC_Orientation == 'Wide' then TextArea = WTextArea
  1654.     else TextArea = TTextArea
  1655.  
  1656.     GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
  1657.     DISPLAYPREFS Measure Inches
  1658.     GETSECTIONSETUP Top Bottom Inside Outside
  1659.     parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
  1660.  
  1661.     GETPAGESETUP Width Height
  1662.     parse var result FullWidth FullHeight
  1663.  
  1664.     TextBlockPrefs TEXTFLOW None
  1665.   end
  1666.   else if App = 'PGS' then do
  1667.     TextBase = 1
  1668.     GETFONTLIST FontNames
  1669.     FontNames.COUNT = result
  1670.     do i = 0 to 5 by 5
  1671.       do j = 0 to FontNames.COUNT - 1
  1672.         if upper(Font.i) == upper(FontNames.j) then leave
  1673.       end
  1674.       if j == FontNames.COUNT then do
  1675.         call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
  1676.         Font.i = DefaultFont
  1677.       end
  1678.     end
  1679.     GETMASTERPAGES MPage; PageName = MPage.0
  1680.     GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
  1681.     UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
  1682.     SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
  1683.     GETMARGINGUIDES temp
  1684.     Margin.Left   = temp.inside
  1685.     Margin.Right  = temp.outside
  1686.     Margin.Top    = temp.top
  1687.     Margin.Bottom = temp.bottom
  1688.  
  1689.     GETDIMENSIONS layout MASTERPAGE "'"PageName"'"
  1690.     if layout.orientation == 'LANDSCAPE' then do
  1691.       TextArea   = WTextArea
  1692.       FullWidth  = layout.height
  1693.       FullHeight = layout.width
  1694.     end
  1695.     else do
  1696.       TextArea   = TTextArea
  1697.       FullWidth  = layout.width
  1698.       FullHeight = layout.height
  1699.     end
  1700.   end
  1701.  
  1702.   PrintWidth       = FullWidth - Margin.Left - Margin.Right
  1703.   PrintHeight      = FullHeight - Margin.Top - Margin.Bottom
  1704.  
  1705.   if App == 'FW' then do
  1706.     GETOBJECTCOORDS TempDateID; Parse Var result . . . . Height.4pt
  1707.   end
  1708.   else if App == 'PGS' then Height.4pt = GetHeight(4pt)
  1709.   if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then
  1710.       PrintHeight = PrintHeight - Height.4pt
  1711.  
  1712.   BoxWidth         = PrintWidth/7
  1713.   CalRight         = Margin.Left + BoxWidth * 7
  1714.   TextArea         = TextArea * PrintHeight
  1715.   CalTop           = TextArea + Margin.Top
  1716.   BoxHeight        = (PrintHeight - TextArea)/5
  1717.   DateOffset       = DateOffset * BoxWidth
  1718.   FSize.Date       = BoxHeight/HighlightRows * 72 * StretchDateH
  1719.   Width.Date       = Width.Date * StretchDateW / StretchDateH
  1720.   FSize.Highlight  = BoxHeight/AddEventRows * 72
  1721.   if App == 'FW' then FSize.Highlight = max(trunc(FSize.Highlight), 4)
  1722.   if App == 'FW' then FSize.Date = max(trunc(FSize.Date), 4)
  1723.   Height.Highlight = GetHeight(Highlight) * Leading/100
  1724.   Height.Date      = GetHeight(Date) * Leading/100
  1725.  
  1726.   FontInfo = compress(Font.Highlight''FSize.Highlight, '. /:')
  1727.   FontKnown.FontInfo = Highlight
  1728.  
  1729.   RowsThatFit      = trunc(BoxHeight / Height.Highlight + 0.05)
  1730.   Width.WidthOfDate1 = GetFontWidth(Date, '1')
  1731.   Width.WidthOfDate8 = GetFontWidth(Date, '8')
  1732.   VariablesSet = 1
  1733. return
  1734. /**/
  1735.  
  1736. /***//*******  VarList () Subroutine  ***********/
  1737. ReturnVarListLoc:
  1738.   return SIGL + 2
  1739. VarListLoc:
  1740.   /* WTextArea      = fraction of print height used for top of calendar (Wide) */
  1741.   /* TTextArea      = fraction of print height used for top of calendar (Tall) */
  1742.   /* DateOffset     = fraction of box width to offset dates from edge of box   */
  1743.   /* MiniCalHeight  = fraction of text area height used for minicals           */
  1744.   /* MiniCalWidth   = width-to-height ratio for minicals                       */
  1745.   /* MiniCalSpacing = fraction of print width placed between FY minicals       */
  1746.   signal ReturnVarListLoc
  1747. VarList:
  1748.   AddEventRows          = 9
  1749.   AdjustDST             = 1
  1750.   AltColor.Date         = Black$
  1751.   AltColor.Extended     = Black$
  1752.   AltColor.Highlight    = Black$
  1753.   AltColor.HighlightH   = Black$
  1754.   AltColor.Julian       = Black$
  1755.   AltColor.Sunrise      = Black$
  1756.   AltColor.Sunset       = Black$
  1757.   AltColor.WeekNumber   = Black$
  1758.   Background.AddEvent   = White$
  1759.   Background.Highlight  = White$
  1760.   Background.HighlightH = White$
  1761.   Background.MiniCal    = White$
  1762.   Background.Weekend    = White$
  1763.   BelzierFactor         = .55
  1764.   Bold.FYMiniCal        = DefaultBold
  1765.   Bold.MiniCal          = DefaultBold
  1766.   CenterMiniDates       = 1
  1767.   Clear$                = 'Clear'
  1768.   Color.AddEvent        = Black$
  1769.   Color.Date            = Black$
  1770.   Color.Extended        = Black$
  1771.   Color.Friday          = Black$
  1772.   Color.Header          = Black$
  1773.   Color.Highlight       = Black$
  1774.   Color.HighlightH      = Black$
  1775.   Color.Julian          = Black$
  1776.   Color.MiniCal         = Black$
  1777.   Color.Monday          = Black$
  1778.   Color.Moon            = Black$
  1779.   Color.Saturday        = Black$
  1780.   Color.Sunday          = Black$
  1781.   Color.Sunrise         = Black$
  1782.   Color.Sunset          = Black$
  1783.   Color.Thursday        = Black$
  1784.   Color.Tuesday         = Black$
  1785.   Color.Wednesday       = Black$
  1786.   Color.Weekday         = Black$
  1787.   Color.WeekNumber      = Black$
  1788.   DateOffset            = 0.02
  1789.   DoBackgrounds         = 0
  1790.   DoDailyColors         = 0
  1791.   DoDateBox             = 0
  1792.   DoEaster              = 1
  1793.   DoExtended            = 1
  1794.   DoHighlights          = 0
  1795.   DoImages              = 0
  1796.   DoJulian              = 0
  1797.   DoJulianLeft          = 0
  1798.   DoMatchColors         = 0
  1799.   DoMiniCals            = 1
  1800.   DoPhases              = 0
  1801.   DoSunRise             = 0
  1802.   DoSunSet              = 0
  1803.   DoWeekNumber          = 0
  1804.   FinalView             = 75
  1805.   Font.Date             = DefaultFont
  1806.   Font.Extras           = DefaultFont
  1807.   Font.FYMiniCal        = DefaultFont
  1808.   Font.Header           = DefaultFont
  1809.   Font.Highlight        = DefaultFont
  1810.   Font.MiniCal          = DefaultFont
  1811.   Font.Weekday          = DefaultFont
  1812.   GfxAppPath            = ''
  1813.   HeaderLoc             = 2
  1814.   HighlightRows         = 9
  1815.   LaunchM               = ''
  1816.   LaunchY               = ''
  1817.   Leading               = 100
  1818.   Line.AddEvent         = Black$
  1819.   Line.Extended         = Black$
  1820.   Line.Grid             = Black$
  1821.   Line.MiniCal          = Black$
  1822.   MagnifyExtras         = 1
  1823.   Margin.Bottom         = 0
  1824.   Margin.Left           = 0
  1825.   Margin.Right          = 0
  1826.   Margin.Top            = 0
  1827.   MaxImgHeight          = .75
  1828.   MaxImgWidth           = .75
  1829.   MiniCalHeight         = 0.60
  1830.   MiniCalSpacing        = 0.05
  1831.   MiniCalWidth          = 2
  1832.   MinWidth              = 80
  1833.   MoonRadius            = .075
  1834.   Orientation           = 'Wide'
  1835.   ShiftLMini            = 0
  1836.   ShiftRMini            = 0
  1837.   StartWeek             = 0
  1838.   StretchDateH          = 1
  1839.   StretchDateW          = 1
  1840.   SunCalcPath           = ''
  1841.   Text.Julian           = ''
  1842.   Text.Sunrise          = ''
  1843.   Text.Sunset           = ''
  1844.   Text.WeekNumber       = ''
  1845.   Width.Date            = 100
  1846. return
  1847. /**/
  1848.  
  1849.